home *** CD-ROM | disk | FTP | other *** search
/ The Ultimate Window Set -…Games & Quality Programs / The Ultimate Window Set - 250 Games & Quality Programs.iso / win / pro125 / discard.cdl < prev    next >
Text File  |  1993-09-20  |  3KB  |  151 lines
  1. //⌐ David Jean, 1993
  2. game discard is 17 by 11;
  3.  
  4. // A1 A2 A3 A4
  5. //  D1     D2
  6.  
  7. {--------------------------------------------------------------------------}
  8.  
  9. {****c1 et c2 sont de meme sorte}
  10. predicate SameSuite?(c1, c2 : Card) is
  11.   return (c1 / 13) = (c2 / 13);
  12.  
  13. {****c2 est plus petit que c1}  
  14. predicate Smaller?(c1, c2 : Card) is
  15.   return (c1 mod 13) < (c2 mod 13);
  16.  
  17. {--------------------------------------------------------------------------}
  18.  
  19. procedure About is
  20. begin
  21.   Clear 'About Discard';
  22.   write('Rules from : 150 solitaire games by Douglas Brown, Harrow Books, 1972.\n');
  23.   write('Program : ⌐ David Jean, 1993.\n');
  24. end;
  25.  
  26. stack A1;
  27. stack A2;
  28. stack A3;
  29. stack A4;
  30.  
  31. stack D2 is
  32.   X := 12;
  33.   Y := 7;
  34.   Direction := over;
  35.   w := 3;
  36.   h := 4;
  37. end D2;
  38.  
  39. stack D1 is
  40.   X := 4;
  41.   Y := 7;
  42.   Direction := over;
  43.   w := 3;
  44.   h := 4;
  45.   //****************************
  46.   Start is
  47.     begin
  48.     Add Ace+Spade .. king+Diamond;
  49.     Turn [1..52] side down;
  50.     Shuffle;
  51.     [0]:=CrossCard;
  52.     end;
  53.   //****************************
  54.   Select(Spos : Index) is
  55.     begin
  56.     with it do
  57.       begin
  58.       Pull 1 to it;
  59.       Turn it[it!] side up;
  60.       Draw it;
  61.       end
  62.     for A1, A2, A3, A4;
  63.     end;
  64.   //****************************
  65.   Help is
  66.     begin
  67.     Clear 'The Stock';
  68.     Write('Click a mouse button here to deal four more cards.\n');
  69.     Wait 'About...' About;
  70.     end;
  71. end D1;
  72.  
  73. {--------------------------------------------------------------------------}
  74.  
  75. stack A1 is
  76.   X := 2;
  77.   Y := 2;
  78.   Direction := over;
  79.   w := 3;
  80.   h := 4;
  81.   //****************************
  82.   Start is
  83.     begin
  84.     Pull 1 from D1;
  85.     Turn [1] side up;
  86.     end;
  87.   //****************************
  88.   SelectFrom(Spos : Index) is
  89.     begin
  90.     with it do
  91.       if it<>self then
  92.         if SameSuite?([!],it[it!]) and Smaller?([!],it[it!]) then
  93.           begin
  94.           Pull 1 to D2;
  95.           Turn D2[D2!] side down;
  96.           break procedure;          
  97.           end
  98.     for A1, A2, A3, A4;
  99.     Pull 1 to Cursor;
  100.     end;
  101.   //****************************
  102.   SelectTo(Spos : Index) is
  103.     if !=0 then Pull 1 from Cursor;
  104.   //****************************
  105.   Help is
  106.     begin
  107.     Clear 'The Tableau';
  108.     Write('Any card lower in value than another of its suit can be discarded ');
  109.     Write('by clicking on it with a mouse button.\n');
  110.     Write('Kings are high and Aces are low.\n\n');
  111.     Write('An empty space can be filled by dragging any visible card on it.\n\n');
  112.     Write('The goal is to end with only the four Kings remaining on The Tableau.\n');
  113.     Wait 'About...' About;
  114.     end;
  115. end A1;
  116.  
  117. stack A2 from A1 is
  118.   X := 6;
  119.   Y := 2;
  120. end A2;
  121.  
  122. stack A3 from A1 is
  123.   X := 10;
  124.   Y := 2;
  125. end A3;
  126.  
  127. stack A4 from A1 is
  128.   X := 14;
  129.   Y := 2;
  130. end A4;
  131.  
  132. {--------------------------------------------------------------------------}
  133.  
  134. predicate Win? is 
  135.   return (D1!=0) and (A1!=1) and (A2!=1) and (A3!=1) and (A4!=1);
  136.  
  137. //ok, loose satisfies win, but win is verified first
  138. predicate Loose? is
  139. var t : integer;
  140. begin
  141.   if D1!>0 then return FALSE;
  142.   t:=0;
  143.   with it do
  144.     if it!>0 then
  145.       t:=t+1<<((it[it!] mod 52) / 13)
  146.   for A1, A2, A3, A4;
  147.   return (t=15);
  148. end;  
  149.  
  150. order D1, D2, A1, A2, A3, A4.
  151.